(*  :Title:	Object-Oriented Extensions  *)

(*  :Authors:	Brian Evans, James McClellan  *)

(*  :Summary:	To implement slots and methods in Mathematica  *)

(*  :Context:	SignalProcessing`ObjectOriented`Slot`  *)

(*  :PackageVersion:  2.7	*)

(*
    :Copyright:	Copyright 1989-1991 by Brian L. Evans
		Georgia Tech Research Corporation

	Permission to use, copy, modify, and distribute this software
	and its documentation for any purpose and without fee is
	hereby granted, provided that the above copyright notice
	appear in all copies and that both that copyright notice and
	this permission notice appear in supporting documentation,
	and that the name of the Georgia Tech Research Corporation,
	Georgia Tech, or Georgia Institute of Technology not be used
	in advertising or publicity pertaining to distribution of the
	software without specific, written prior permission.  Georgia
	Tech makes no representations about the suitability of this
	software for any purpose.  It is provided "as is" without
	express or implied warranty.
 *)

(*  :History:	*)

(*  :Keywords:	*)

(*  :Source:	*)

(*  :Warning:	*)

(*  :Mathematica Version:  1.2 or 2.0  *)

(*  :Limitation:  *)

(*
    :Discussion:  Internally, slots and methods are represented as collection
		    of delayed substitution rules (slot :> value).
		  In order to determine the value of a slot, recursive
		    application of the rule base is used so that the
		    value of a slot can rely on the value of other slots
		    in the same object.
		  Length will return the number of slots in the object.
 *)

(*
    :Functions:	  AddSlot
		  AppendSlot
		  DefaultSlot
		  DefineObjectType
		  DeleteSlot
		  HasSlotQ
		  MakeObject
		  ReadSlot
		  WriteSlot
 *)



(*  B E G I N     P A C K A G E  *)

BeginPackage [ "SignalProcessing`ObjectOriented`Slot`",
	       "SignalProcessing`ObjectOriented`StackQueue`",
	       "SignalProcessing`Support`SupCode`" ]


If [ TrueQ[ $VersionNumber >= 2.0 ],
     Off[ General::spell ];
     Off[ General::spell1 ] ];


(*  U S A G E     I N F O R M A T I O N  *)

AddSlot::usage =
	"AddSlot[object, writeflag, slot, initvalue] adds the slot to \
	object, where object (a symbol assigned to the object's value) \
	is mutated; initvalue is the initial value assigned to this \
	new slot and writeflag is True if the slot can be overwritten. \
	The object is returned if the slot slot already exists. \
	Note that initvalue can be a collection of values like 1,2,3."

AKindOf::usage =
	"AKindOf is a slot that describes the class to which \
	the object belongs."

AppendSlot::usage =
	"AppendSlot[object, slot, appendfun, addvalue] will set the \
	value of the slot slot in object to the value returned by \
	calling appendfun with two arguments:  the old value of the \
	slot and addvalue. \
	Note that object is an unevaluated symbol and that addvalue \
	can be a collection of values like 1,2,3."

DefaultSlot::usage =
	"DefaultSlot[object_tag, slot, value] will set up the value as the \
	default for the slot in any object with a tag of object_tag. \
	For example, to set up 0 as the default value for the slot \
	CurrentValue of a Signal, use DefaultSlot[Signal, CurrentValue, 0]."

DefineObjectType::usage =
	"DefineObjectType[object, parent_object] clears the attributes \
	of object and sets the HoldRest attribute."

DeleteSlot::usage =
	"DeleteSlot[object, slot] removes the slot slot from object and \
	returns the new object. \
	Note that object is an unevaluated symbol."

HasSlotQ::usage =
	"HasSlotQ[object, slot] returns True if the slot slot exists \
	in object."

MakeObject::usage =
	"MakeObject[object] returns a packet of data tagged with object. \
	Note that an object must at most have the attribute of HoldRest. \
	See DefineObjectType."

ReadOnlyList::usage =
	"ReadOnlyList is the slot which keeps track of the slots/methods \
	which can not be altered."

ReadOnlySlotQ::usage =
	"ReadOnlySlotQ[object, slot_or_method] returns True if the \
	slot_or_method can not be altered in the object."

ReadSlot::usage =
	"ReadSlot[object, slot] returns the contents of the slot slot \
	in object. \
	Note that object is an unevaluated symbol."

WriteSlot::usage =
	"WriteSlot[object, slot, value] attempts to write over the slot \
	slot in object. \
	If the slot slot is read-only, then object is returned unaltered. \
	If the slot is not write protected, then the slot slot in object \
	is overwritten with value. \
	Note that object is an unevaluated symbol and that a slot value \
	cannot be a collection of values like (1, 2, 3)."

(*  E N D     U S A G E     I N F O R M A T I O N  *)


Begin[ "`Private`" ]


(*  M E S S A G E S  *)

AddSlot::slotexists = "The slot `` already exists in the `` object."
DeleteSlot::slotmissing = "The slot `` is missing in a `` object."
DeleteSlot::slotprotected = "The slot `` can not be deleted in a `` object."
ReadSlot::notexist = "The slot `` does not exist in the `` object."
ReadOnlySlotQ::dontknow =
	"Cannot determine if slot `` is read-only --  assuming it is."
WriteSlot::readonly = "Can not write to slot `` in a `` object."


(*  G L O B A L S  *)

defaultslotcode = "`1`/: DefaultSlot[`1`[slots__], `2`] := `3`"
SetAttributes[defaultslotcode, {Protected, Locked}]


(*  S U P P O R T I N G     F U N C T I O N S  *)

(*  HasSlotQ  *)
HasSlotQ[h_[objslots__], slot_] := ! SameQ[slot, Replace[slot, {objslots}]]

(*  MakeSlot[slotname, value] returns a packet of slot data:	*)
(*  Slot[slotname][value].					*)
MakeSlot[slotname_, value_] := slotname :> value
MakeSlot[slotname_, value_, rest__] := slotname :> {value, rest}

(*  ObjectRead[object, slot] returns the value of slot	*)
ObjectRead[h_[objslots__], slot_] := ReplaceRepeated[slot, {objslots}]
ReadOnlyList/: ObjectRead[h_[objslots__], ReadOnlyList] := 
	Replace[ReadOnlyList, {objslots}]

(*  ObjectWrite[object, slot, value] overwrites slot in object with value.  *)
ObjectWrite[object_, slot_, value_] :=
	Block [	{newobj, pos},
		pos = SlotPosition[object, slot];
		If [ pos == 0,
		     object,
		     newobj = object;
		     newobj[[pos]] = MakeSlot[slot, value];
		     newobj ] ]

(*  SlotPosition[object, slot] returns the index in the  *)
(*  data packet object at which the slot resides.	 *)
SlotPosition[object_, slot_] :=
	Block [ {length, pos = 0, searchpattern, slotnum, x},
		searchpattern = MakeSlot[slot, x_];
		length = Length[object];
		For [ slotnum = 1, slotnum <= length, slotnum++,
		      If [ MatchQ[ object[[slotnum]], searchpattern ],
			   pos = slotnum; Break[] ] ];
		pos ]


(*  S L O T - B A S E D     F U N C T I O N S  *)

(*  All of these function are exported to the global environment  *)

(*  Because we will mutate the first argument, set the HoldFirst attribute  *)

SetAttributes[AddSlot, {HoldFirst}]
SetAttributes[AppendSlot, {HoldFirst}]
SetAttributes[DefineObjectType, {HoldAll}]
SetAttributes[DeleteSlot, {HoldFirst}]
SetAttributes[MakeObject, {HoldFirst}]
SetAttributes[ReadSlot, {HoldAll}]
SetAttributes[ReadOnlySlotQ, {HoldAll}]
SetAttributes[WriteSlot, {HoldFirst}]


(*  AddSlot  *)
AddSlot[object_, writeflag_, slot_, initvalue__] :=
	Block [	{newobj, result},
		If [ HasSlotQ[object, slot],
		     Message[AddSlot::slotexists, slot, Head[object]];
		     Return[object] ];
		newobj = If [ TrueQ[writeflag],
			      object,
			      AppendSlot[object, ReadOnlyList, Append, slot] ];
		object = Sort[ PrependTo[newobj, MakeSlot[slot, initvalue]] ] ]

(*  AppendSlot  *)
AppendSlot[object_, slot_, appendfun_, addvalue__ ] :=
	object = If [ HasSlotQ[object, slot],
		      WriteSlot[object,
				slot,
				appendfun[ReadSlot[object, slot], addvalue]],
		      AddSlot[object, True, slot, addvalue] ]

(*  DefaultSlot  *)
DefaultSlot[object_Symbol, slot_] :=
	Message[ReadSlot::notexist, slot, object]
DefaultSlot[object_Symbol, slot_, value_] :=
	TagSetDelayed[object, DefaultSlot[object, slot], value]


(*  DefineObjectType --  operates on value of object not the literal  *)
(*  symbol object so the attributes of Attributes must be changed  *)
DefineObjectType[object_] :=
	Block [ {},
		ClearAttributes[Attributes, HoldAll];
		Attributes[object] = {};
		SetAttributes[object, {HoldRest}];
		SetAttributes[Attributes, HoldAll];
		object ]

(*  DeleteSlot --  one can never delete ReadOnlyList  *)
DeleteSlot[object_, slot_] :=
	Block [	{pos, result, slotlist},
		pos = SlotPosition[object, slot];
		Which [ SameQ[pos, 0],
			  MyMessage[DeleteSlot::slotmissing, object,
			  	    slot, Head[object]],
			SameQ[slot, ReadOnlyList],
			  MyMessage[DeleteSlot::slotprotected, object,
			  	    ReadOnlyList, Head[object]],
			True,
			  newobj = object;
			  If [ ReadOnlySlotQ[newobj, slot],
			       readonlylist = ReadSlot[newobj, ReadOnlyList];
		  	       newobj = WriteSlot[newobj,
			       			  ReadOnlyList,
						  Complement[readonlylist,
							     {slot}]] ];
			  object = Drop[newobj, {pos, pos}] ] ]

(*  MakeObject  *)
MakeObject[object_] := object [ MakeSlot[ReadOnlyList, {}] ]

(*  ReadSlot  *)
ReadSlot[object_, slot_] := ObjectRead[object, slot] /; HasSlotQ[object, slot]
ReadSlot[object_, slot_] := DefaultSlot[Head[object], slot]

(*  ReadOnlySlotQ  *)
ReadOnlySlotQ[object_, slot_] := False /; ! HasSlotQ[object, ReadOnlyList]
ReadOnlySlotQ[object_, slot_] := MemberQ[ReadSlot[object, ReadOnlyList], slot]

(*  WriteSlot  *)
WriteSlot[object_, slot_, value__] :=
	Which [ ! HasSlotQ[object, slot],
		  object = AddSlot[object, True, slot, value],
		ReadOnlySlotQ[object, slot],
		  MyMessage[WriteSlot::readonly, object, slot, Head[object]],
	        True,
		  object = ObjectWrite[object, slot, value] ]


(*  E N D     P A C K A G E  *)

End[]
EndPackage[]

If [ TrueQ[ $VersionNumber >= 2.0 ],
     On[ General::spell ];
     On[ General::spell1 ] ];


(*  E N D I N G     M E S S A G E  *)

Print["Object-oriented extensions loaded."]
Null
